Ciencia de Datos con R: Riesgo de Crédito

library(tidyverse)
library(readxl)
library(kableExtra)
lgd <- read.csv('LGD_Mortgage.csv', fileEncoding="UTF-8-BOM")

lgd |>
  head(30) |> 
  kable()|> 
  row_spec(seq(1,30,2), background="cyan") %>% 
  kable_styling(full_width=FALSE)

theme_set(theme_minimal())
library(plotly)
(lgd |>
  ggplot(aes(lgd)) +
  geom_histogram(colour="black",
                   aes(y = ..count.. , fill = ..count..),
                   show.legend = FALSE,
                   bins = 30)+
  scale_fill_gradient("Count", low="white", high="forestgreen")+
  xlab("Loss Given Default") ) |> 
  ggplotly()

library(gridExtra)
theme_set(theme_minimal())
df <- lgd
p1 <- df %>% 
   ggplot(aes(lgd)) +
  geom_histogram(colour="black",
                   aes(y=..count..,fill=..count..),
                   show.legend = FALSE,
                   bins = 30)+
  scale_fill_gradient("Count", low="white", high="forestgreen")+
  xlab("Loss Given Default")

p2 <- df %>% 
   ggplot(aes(updatedcltv)) +
  geom_histogram(colour="black",
                   aes(y=..count..,fill=..count..),
                   show.legend = FALSE,
                   bins = 30)+
  scale_fill_gradient("Count", low="white", high="forestgreen")+
  xlab("Updated CLTV")

p3 <- df %>% 
   ggplot(aes(timetoliquidation)) +
  geom_histogram(colour="black",
                   aes(y=..count..,fill=..count..),
                   show.legend = FALSE,
                   bins = 30)+
  scale_fill_gradient("Count", low="white", high="forestgreen")+
  xlab("Time to Liquidation")
grid.arrange(p1,p2,p3,ncol=3)

df1 <- lgd
p4 <- df1 %>% 
  ggplot(aes(updatedcltv, lgd))+
  geom_point(alpha = 0.5, color = 'forestgreen')+
  geom_smooth(method='lm')

p5 <- df1 %>% 
  ggplot(aes(updatedcltv, lgd, colour = as.factor(updatedcltv_missing)))+
  geom_point(alpha = 0.5)+
  labs(colour="Upcltv \nMissing")

grid.arrange(p4,p5,ncol=2)

df1 %>% 
  ggplot(aes(timetoliquidation, lgd))+
  geom_point(alpha = 0.5, color = 'forestgreen')+
  geom_smooth(method='lm')

p6 <- df1 %>% 
  ggplot(aes(singlehome, lgd, fill=as.factor(singlehome), colour = as.factor(singlehome)))+
  geom_boxplot(alpha = 0.3, show.legend = FALSE)

p7 <- df1 %>% 
  ggplot(aes(occupied, lgd, fill = as.factor(occupied), colour = as.factor(occupied)))+
  geom_boxplot(alpha = 0.3, show.legend = FALSE)

grid.arrange(p6,p7,ncol=2)

library(tidymodels)
df1 <- df %>% select(lgd,
                     updatedcltv_missing,
                     updatedcltv,
                     timetoliquidation,
                     occupied,
                     singlehome)

lm_spec <- linear_reg() %>%
  set_mode("regression") %>%
  set_engine("lm")

lm_fit <- lm_spec %>%
  fit(lgd ~ updatedcltv_missing + 
        updatedcltv+
        timetoliquidation+
        occupied+
        singlehome, 
      data = df1)

lm_fit %>% 
  tidy() %>% 
  select(term,estimate, p.value) %>% 
   kable(booktabs = TRUE,
        align = 'lrr',
        linesep = "",
        caption = "Estimated Coefficients",
        format.args = list(big.mark = ",",digits = 3)) %>%
  row_spec(seq(1,6,2), background="cyan") %>% 
  kable_styling(full_width=FALSE)

x <- glance(lm_fit) %>% select(c(1,8,9))
lm_model <- lm(lgd ~ updatedcltv_missing + 
        updatedcltv+
        timetoliquidation+
        occupied+
        singlehome, 
      data = df1)
library(modelr)
MAE <- mae(lm_model,df1)
MSE <- mse(lm_model,df1)
AIC <- x$AIC
BIC <- x$BIC
R2 <- x$r.squared

x <- as_tibble(cbind(MAE,AIC,BIC,MSE,R2))
x %>% kable(booktabs = TRUE,
        align = 'ccccc',
        linesep = "",
        caption = "Evaluation Metrics",
        format.args = list(big.mark = ",",digits = 4, scientific=FALSE)) %>%
  row_spec(1,background="cyan") %>% 
  kable_styling(full_width=FALSE)

df %>% 
  select(liquidationdate,lgd,predlgd) %>% 
  group_by(liquidationdate) %>% 
  summarise(lgd_mean = mean(lgd),
            predlgd_mean = mean(predlgd)) %>% 
  mutate(liquidationdate = as.Date(paste(liquidationdate,01), format = "%Y%m%d")) %>%
  ggplot(aes(liquidationdate))+
  geom_line(aes(y= lgd_mean, color = "Observed"),lwd =1.3,alpha=0.7)+
  geom_line(aes(y= predlgd_mean,color='Forecast'),lwd=1.3,alpha=0.7)+
  ylim(0,60)+
  scale_x_date(breaks = scales::breaks_pretty(20))+
  theme(axis.text.x=element_text(angle=90,hjust=1),
        plot.title = element_text(hjust = 0.5))+
  labs(x = "Liquidation Date", y = "LGD (%)", color = "Legend")+
  ggtitle("LGD - All Loans")

detach("package:modelr", unload=TRUE)
#etach_package("modelr", TRUE)
library(doParallel)
library(xgboost)
df1 <- df %>% select(lgd,
                     fico,
                     loanage,
                     updatedcltv,
                     timetoliquidation,
                     occupied,
                     singlehome)
lgd_train <- df1
# Define Xgboost Model
xgb_spec <- boost_tree(
  trees = 1000,
  tree_depth = tune(),
  min_n = tune(),
  loss_reduction = tune(),
  sample_size = tune(),
  mtry = tune(),
  learn_rate = tune(),
) %>%
  set_engine("xgboost", objective = "reg:squarederror") %>%
  set_mode("regression")

# Define Grid: Space filling Design 
xgb_grid <- grid_latin_hypercube(
  tree_depth(),
  min_n(),
  loss_reduction(),
  sample_size = sample_prop(),
  finalize(mtry(), lgd_train),
  learn_rate(),
  size = 90
)

# Define Workflow
xgb_wf <- workflow() %>%
  add_formula(lgd ~ .) %>%
  add_model(xgb_spec)

# Define CV Folds
set.seed(123)
lgd_folds <- vfold_cv(lgd_train, strata = lgd)

# High Performance Computation
all_cores <- parallel::detectCores()
registerDoParallel(cores = all_cores)

# Tuning: Grid Search
set.seed(234)

xgb_res <- tune_grid(
  xgb_wf,
  resamples = lgd_folds,
  grid = xgb_grid,
  control = control_grid(save_pred = TRUE, verbose =TRUE),
  metrics = metric_set(rmse, rsq, mae)
)